home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / rmail / rmail-xemacs.el.z / rmail-xemacs.el
Encoding:
Text File  |  1998-05-21  |  8.2 KB  |  236 lines
  1. ;;; rmail-xemacs.el --- Mouse and font support for RMAIL running on XEmacs
  2.  
  3. ;; Copyright (C) 1992-1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Wilson H. Tien <wtien@urbana.mcd.mot.com>
  6. ;; Keywords: mail
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  23. ;; 02111-1307, USA.
  24.  
  25. ;;; Synched up with: Not in FSF.
  26.  
  27. ;;; Commentary:
  28.  
  29. ;; Mouse and font support for RMAIL running in Lucid GNU Emacs
  30. ;; written by Wilson H. Tien (wtien@urbana.mcd.mot.com); modified by jwz.
  31.  
  32. ;; Right button pops up a menu of commands in Rmail and Rmail summary buffers.
  33. ;; Middle button selects indicated mail message in Rmail summary buffer
  34.  
  35. ;;; Code:
  36.  
  37. (defvar rmail-summary-mode-menu
  38.   '("Rmail Summary Commands"
  39.     ["Select Message" rmail-summary-goto-msg t nil]
  40.     "----"
  41.     ["Previous Page" scroll-down t]
  42.     ["Next Page" scroll-up t]
  43.     "----"
  44.     ["Delete Message" rmail-summary-delete-forward t nil]
  45.     ["Undelete Message" rmail-summary-undelete t nil]
  46.     "----"
  47.     ["Exit rmail Summary" rmail-summary-exit t]
  48.     ["Quit rmail" rmail-summary-quit t]))
  49.  
  50. (defun rmail-summary-update-menubar ()
  51.   ;; if min point is in visible in the window, don't make page-up menu item
  52.   ;; selectable
  53.   (let ((current-menubar rmail-summary-mode-menu)
  54.     (select '("Select Message"))
  55.     (delete '("Delete Message"))
  56.     (undelete '("Undelete Message"))
  57.     (prev-page '("Previous Page"))
  58.     (next-page '("Next Page")))
  59.     (beginning-of-line)
  60.     (let ((curmsg (string-to-int
  61.          (buffer-substring (point)
  62.                    (min (point-max) (+ 5 (point))))))
  63.       deleted-p)
  64.       (if (= 0 curmsg)
  65.       (progn
  66.         (rmail-update-menu-item delete nil)
  67.         (rmail-update-menu-item undelete nil)
  68.         (rmail-update-menu-item select nil))
  69.     (pop-to-buffer rmail-buffer)
  70.     (setq deleted-p (rmail-message-deleted-p curmsg))
  71.     (pop-to-buffer rmail-summary-buffer)
  72.     (let ((delete-menu-item 
  73.            (car (find-menu-item current-menubar delete)))
  74.           (undelete-menu-item 
  75.            (car (find-menu-item current-menubar undelete)))
  76.           (select-menu-item 
  77.            (car (find-menu-item current-menubar select)))
  78.           (msg (format "#%d" curmsg)))
  79.       (aset delete-menu-item 2 (not deleted-p))
  80.       (aset delete-menu-item 3 msg)
  81.       (aset undelete-menu-item 2 deleted-p)
  82.       (aset undelete-menu-item 3 msg)
  83.       (aset select-menu-item 2 t)
  84.       (aset select-menu-item 3 msg))))
  85.     (rmail-update-menu-item prev-page (> (window-start) (point-min)))
  86.     (rmail-update-menu-item next-page (< (window-end) (point-max)))))
  87.   
  88. (defun rmail-summary-mode-menu (event)
  89.   "Pops up a menu of applicable rmail summary commands."
  90.   (interactive "e")
  91.   (mouse-set-point event)
  92.   (beginning-of-line)
  93.   (rmail-summary-update-menubar)
  94.   (popup-menu rmail-summary-mode-menu))
  95.  
  96. ;; The following are for rmail mode 
  97. (defconst rmail-mode-menu
  98.   '("Rmail Commands"
  99.     ["Previous Page" scroll-down t]
  100.     ["Next Page" scroll-up t]
  101.     ["Top Of This Message" rmail-beginning-of-message t]
  102.     "----"
  103.     "Go To Message:"
  104.     "----"
  105.     ["Next Nondeleted Message" rmail-next-undeleted-message t]
  106.     ["Previous Nondeleted Message" rmail-previous-undeleted-message t]
  107.     ["Next Message" rmail-next-message t]
  108.     ["Previous Message" rmail-previous-message t]
  109.     ["First Message" rmail-show-message t]
  110.     ["Last Message" rmail-last-message t]
  111.     "----"
  112.     ["Delete This Message" rmail-delete-forward t]
  113.     ["Undelete This Message" rmail-undelete-previous-message t]
  114.     ["Save This Message" rmail-output-to-rmail-file t]
  115.     "----"
  116.     ["Reply This Message" rmail-reply t]
  117.     ["Forward This Message" rmail-forward t]
  118. ;    ["Continue This Message" rmail-continue t]
  119.     "----"
  120.     ["Add Label" rmail-add-label t]
  121.     ["Kill Label" rmail-kill-label t]
  122.     ["Next Labeled Message" rmail-next-labeled-message t]
  123.     ["Previous Labeled Message" rmail-previous-labeled-message t]
  124.     ["Summary by Label" rmail-summary-by-labels t]
  125.     "----"
  126.     ["Summary" rmail-summary t]
  127.     ["Get New Mail" rmail-get-new-mail t]
  128.     ["rmail Input From" rmail-input t]
  129.     ["Expunge rmail" rmail-expunge t]
  130.     ["Expunge and Save" rmail-expunge-and-save t]
  131.     ["Quit rmail" rmail-quit t]))
  132.  
  133. (defun rmail-update-menu-item (item p)
  134.   "If P is true, enable the menu item. O/w disable it."
  135.   (aset (car (or (find-menu-item current-menubar item)
  136.          (error "couldn't find rmail menu item %S" item)))
  137.     2 p))
  138.  
  139. (defun rmail-update-menubar ()
  140.   (let ((current-menubar rmail-mode-menu)
  141.     (prev-page '("Previous Page"))
  142.     (next-page '("Next Page"))
  143.     (top-page '("Top Of This Message"))
  144.     (real-next '("Next Message"))
  145.     (real-prev '("Previous Message"))
  146.     (undel-next '("Next Nondeleted Message"))
  147.     (undel-prev '("Previous Nondeleted Message"))
  148.     (delete '("Delete This Message"))
  149.     (undelete '("Undelete This Message"))
  150.     i)
  151.     ;; Disable/enable page-up/page-down menu items
  152.     (rmail-update-menu-item prev-page (> (window-start) (point-min)))
  153.     (rmail-update-menu-item next-page (< (window-end) (point-max)))
  154.     (rmail-update-menu-item top-page (> (window-start) (point-min)))
  155.     (rmail-update-menu-item real-next
  156.               (/= rmail-current-message rmail-total-messages))
  157.     (rmail-update-menu-item real-prev (/= rmail-current-message 1))
  158.     (setq i (1+ rmail-current-message))
  159.     (while (and (<= i rmail-total-messages) (rmail-message-deleted-p i))
  160.       (setq i (1+ i)))
  161.     (rmail-update-menu-item undel-next (<= i rmail-total-messages))
  162.     (setq i (1- rmail-current-message))
  163.     (while (and (>= i 1) (rmail-message-deleted-p i))
  164.       (setq i (1- i)))
  165.     (rmail-update-menu-item undel-prev (>= i 1))
  166.     (rmail-update-menu-item delete 
  167.               (not (rmail-message-deleted-p rmail-current-message)))
  168.     (rmail-update-menu-item undelete 
  169.               (rmail-message-deleted-p rmail-current-message))
  170.     t))
  171.   
  172. (defun rmail-mode-menu (event)
  173.   "Pops up a menu of applicable rmail commands."
  174.   (interactive "e")
  175.   (select-window (event-window event))
  176.   (rmail-update-menubar)
  177.   (popup-menu rmail-mode-menu))
  178.  
  179. (defun rmail-activate-menubar-hook ()
  180.   (cond ((eq major-mode 'rmail-mode)
  181.      (rmail-update-menubar))
  182.     ((eq major-mode 'rmail-summary-mode)
  183.      (rmail-summary-update-menubar))))
  184.  
  185. (add-hook 'activate-menubar-hook 'rmail-activate-menubar-hook)
  186.  
  187. ;;; Put message headers in boldface, etc...
  188.  
  189. (require 'highlight-headers)
  190.  
  191. (defun rmail-fontify-headers ()
  192.   (highlight-headers (point-min) (point-max) t))
  193.  
  194. (add-hook 'rmail-show-message-hook 'rmail-fontify-headers)
  195.  
  196. ;; MENU and MENUBAR setup for both Rmail and Rmail summary buffers
  197. (defun rmail-install-menubar ()
  198.   (if (and current-menubar (not (assoc (car rmail-mode-menu) current-menubar)))
  199.       (let ((menu (cond ((eq major-mode 'rmail-mode) rmail-mode-menu)
  200.             ((eq major-mode 'rmail-summary-mode)
  201.              rmail-summary-mode-menu)
  202.             (t (error "not rmail or rmail summary mode")))))
  203.     (set-buffer-menubar (copy-sequence current-menubar))
  204.     (add-menu nil (car rmail-mode-menu) (cdr menu)))))
  205.  
  206. (defun rmail-mode-menu-setup ()
  207.   (rmail-install-menubar)
  208.   (define-key rmail-mode-map 'button3 'rmail-mode-menu))
  209.  
  210. (if (featurep 'menubar)
  211.     (add-hook 'rmail-mode-hook 'rmail-mode-menu-setup))
  212.  
  213. (defun rmail-summary-mode-menu-setup ()
  214.   (rmail-install-menubar)
  215.   (define-key rmail-summary-mode-map 'button2 'rmail-summary-mouse-goto-msg)
  216.   (define-key rmail-summary-mode-map 'button3 'rmail-summary-mode-menu))
  217.  
  218. (defun rmail-summary-mouse-goto-msg (e)
  219.   (interactive "e")
  220.   (mouse-set-point e)
  221.   (beginning-of-line)
  222.   (rmail-summary-goto-msg))
  223.  
  224. (defun rmail-install-mouse-tracker ()
  225.   (require 'mode-motion)
  226.   (setq mode-motion-hook 'mode-motion-highlight-line))
  227.  
  228. (add-hook 'rmail-summary-mode-hook 'rmail-install-mouse-tracker)
  229. (if (featurep 'menubar)
  230.     (add-hook 'rmail-summary-mode-hook 'rmail-summary-mode-menu-setup))
  231.  
  232.  
  233. (provide 'rmail-xemacs)
  234.  
  235. ;;; rmail-xemacs ends here
  236.